home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / ms_dos / lib / happysrc / pcgencd.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-11-14  |  23.9 KB  |  634 lines
  1. /***************************************
  2.  *                                     *
  3.  *  ** HAPPy Pascal compiler **        *
  4.  *     P-code ソース生成               *
  5.  *                                     *
  6.  *   Copyright (c) H.Asano 1992-1994.  *
  7.  ***************************************/
  8.  
  9. #define  EXTERN  extern
  10. #include <stdio.h>
  11. #include "pascomp.h"
  12. #include "pcpcd.h"
  13.  
  14. extern char *version   ;                /* HAPPyのバージョン番号      */
  15. extern FILE *pcdfile   ;                /* Pコード出力ファイル        */
  16.  
  17.  
  18. /***** function prototype *****/
  19. extern void pcerr(int,char*)  ;
  20. extern boolean string(stp*)   ;
  21. extern void getbounds(stp*,long*,long*) ;
  22. extern void term(void) ;
  23.  
  24. /********** P-code ニーモニック 定義表 **********/
  25.  
  26. static struct {
  27.    char    *mn     ;                   /* P-code mnemonics            */
  28.    short   cdx     ;                   /* stack pointerの動き         */
  29. } icd[iZZZ] ;
  30.  
  31. /***************************************/
  32. /* initpcd() : P-code関連 初期設定処理 */
  33. /***************************************/
  34. void initpcd(void)
  35. {
  36.   /*enum pcdmnc i ;*/
  37.  
  38.   /**** P-code instruction mnmonics の 登録 *****/
  39.    /* for(i=iABI;i<iZZZ;i++) icd[i].cdx = 0 ;*//* staticなので初期化済*/
  40.      icd[iABI].mn  = "abi" ;
  41.      icd[iABR].mn  = "abr" ;
  42.      icd[iADI].mn  = "adi" ;  icd[iADI].cdx =-1 ;
  43.      icd[iADR].mn  = "adr" ;  icd[iADR].cdx =-1 ;
  44.      icd[iAND].mn  = "and" ;  icd[iAND].cdx =-1 ;
  45.      icd[iATN].mn  = "atn" ;
  46.      icd[iBAS].mn  = "bas" ;  icd[iBAS].cdx =+1 ;
  47.      icd[iCHK].mn  = "chk" ;
  48.      icd[iCHR].mn  = "chr" ;
  49.      icd[iCKA].mn  = "cka" ;
  50.      icd[iCOS].mn  = "cos" ;
  51.      icd[iCUI].mn  = "cui" ;  icd[iCUI].cdx =-1 ;
  52.      icd[iCUP].mn  = "cup" ;
  53.      icd[iDEC].mn  = "dec" ;
  54.      icd[iDIF].mn  = "dif" ;  icd[iDIF].cdx =-1 ;
  55.      icd[iDIS].mn  = "dis" ;  icd[iDIS].cdx =-1 ;
  56.      icd[iDVI].mn  = "dvi" ;  icd[iDVI].cdx =-1 ;
  57.      icd[iDVR].mn  = "dvr" ;  icd[iDVR].cdx =-1 ;
  58.      icd[iEJP].mn  = "ejp" ;
  59.      icd[iENT].mn  = "ent" ;
  60.      icd[iEOF].mn  = "eof" ;
  61.      icd[iEOL].mn  = "eol" ;
  62.      icd[iEQU].mn  = "equ" ;  icd[iEQU].cdx =-1 ;
  63.      icd[iEXP].mn  = "exp" ;
  64.      icd[iFJP].mn  = "fjp" ;  icd[iFJP].cdx =-1 ;
  65.      icd[iFLO].mn  = "flo" ;
  66.      icd[iFLT].mn  = "flt" ;
  67.      icd[iGEQ].mn  = "geq" ;  icd[iGEQ].cdx =-1 ;
  68.      icd[iGET].mn  = "get" ;  icd[iGET].cdx =-1 ;
  69.      icd[iGRT].mn  = "grt" ;  icd[iGRT].cdx =-1 ;
  70.      icd[iINC].mn  = "inc" ;
  71.      icd[iIND].mn  = "ind" ;
  72.      icd[iINN].mn  = "inn" ;  icd[iINN].cdx =-1 ;
  73.      icd[iINT].mn  = "int" ;  icd[iINT].cdx =-1 ;
  74.      icd[iIOR].mn  = "ior" ;  icd[iIOR].cdx =-1 ;
  75.      icd[iIXA].mn  = "ixa" ;  icd[iIXA].cdx =-1 ;
  76.      icd[iLAO].mn  = "lao" ;  icd[iLAO].cdx =+1 ;
  77.      icd[iLAP].mn  = "lap" ;  icd[iLAP].cdx =+1 ;
  78.      icd[iLCA].mn  = "lca" ;  icd[iLCA].cdx =+1 ;
  79.      icd[iLDA].mn  = "lda" ;  icd[iLDA].cdx =+1 ;
  80.      icd[iLDC].mn  = "ldc" ;  icd[iLDC].cdx =+1 ;
  81.      icd[iLDO].mn  = "ldo" ;  icd[iLDO].cdx =+1 ;
  82.      icd[iLEQ].mn  = "leq" ;  icd[iLEQ].cdx =-1 ;
  83.      icd[iLES].mn  = "les" ;  icd[iLES].cdx =-1 ;
  84.      icd[iLOD].mn  = "lod" ;  icd[iLOD].cdx =+1 ;
  85.      icd[iLOG].mn  = "log" ;
  86.      icd[iMMS].mn  = "mms" ;  icd[iMMS].cdx =-1 ;
  87.      icd[iMOD].mn  = "mod" ;  icd[iMOD].cdx =-1 ;
  88.      icd[iMOV].mn  = "mov" ;  icd[iMOV].cdx =-2 ;
  89.      icd[iMPI].mn  = "mpi" ;  icd[iMPI].cdx =-1 ;
  90.      icd[iMPR].mn  = "mpr" ;  icd[iMPR].cdx =-1 ;
  91.      icd[iMSI].mn  = "msi" ;  icd[iMSI].cdx =-1 ;
  92.      icd[iMST].mn  = "mst" ;
  93.      icd[iNEQ].mn  = "neq" ;  icd[iNEQ].cdx =-1 ;
  94.      icd[iNEW].mn  = "new" ;  icd[iNEW].cdx =-1 ;
  95.      icd[iNGI].mn  = "ngi" ;
  96.      icd[iNGR].mn  = "ngr" ;
  97.      icd[iNOT].mn  = "not" ;
  98.      icd[iNXT].mn  = "nxt" ;
  99.      icd[iNXD].mn  = "nxd" ;
  100.      icd[iODD].mn  = "odd" ;
  101.      icd[iORD].mn  = "ord" ;
  102.      icd[iPGE].mn  = "pge" ;  icd[iPGE].cdx =-1 ;
  103.      icd[iPUT].mn  = "put" ;  icd[iPUT].cdx =-1 ;
  104.      icd[iRDC].mn  = "rdc" ;  icd[iRDC].cdx =-2 ;
  105.      icd[iRDI].mn  = "rdi" ;  icd[iRDI].cdx =-2 ;
  106.      icd[iRDR].mn  = "rdr" ;  icd[iRDR].cdx =-2 ;
  107.      icd[iRET].mn  = "ret" ;
  108.      icd[iRLN].mn  = "rln" ;  icd[iRLN].cdx =-1 ;
  109.      icd[iROU].mn  = "rou" ;
  110.      icd[iRST].mn  = "rst" ;  icd[iRST].cdx =-1 ;
  111.      icd[iRWT].mn  = "rwt" ;  icd[iRWT].cdx =-1 ;
  112.      icd[iSBI].mn  = "sbi" ;  icd[iSBI].cdx =-1 ;
  113.      icd[iSBR].mn  = "sbr" ;  icd[iSBR].cdx =-1 ;
  114.      icd[iSGS].mn  = "sgs" ;
  115.      icd[iSIN].mn  = "sin" ;
  116.      icd[iSQI].mn  = "sqi" ;
  117.      icd[iSQR].mn  = "sqr" ;
  118.      icd[iSQT].mn  = "sqt" ;
  119.      icd[iSRO].mn  = "sro" ;  icd[iSRO].cdx =-1 ;
  120.      icd[iSTO].mn  = "sto" ;  icd[iSTO].cdx =-2 ;
  121.      icd[iSTP].mn  = "stp" ;
  122.      icd[iSTR].mn  = "str" ;  icd[iSTR].cdx =-1 ;
  123.      icd[iTGT].mn  = "tgt" ;  icd[iTGT].cdx =-1 ;
  124.      icd[iTPT].mn  = "tpt" ;  icd[iTPT].cdx =-1 ;
  125.      icd[iTRA].mn  = "tra" ;
  126.      icd[iTRC].mn  = "trc" ;
  127.      icd[iTRS].mn  = "trs" ;  icd[iTRS].cdx =-1 ;
  128.      icd[iTRW].mn  = "trw" ;  icd[iTRW].cdx =-1 ;
  129.      icd[iUJC].mn  = "ujc" ;
  130.      icd[iUJP].mn  = "ujp" ;
  131.      icd[iUNI].mn  = "uni" ;  icd[iUNI].cdx =-1 ;
  132.      icd[iWLN].mn  = "wln" ;  icd[iWLN].cdx =-1 ;
  133.      icd[iWRB].mn  = "wrb" ;  icd[iWRB].cdx =-3 ;
  134.      icd[iWRC].mn  = "wrc" ;  icd[iWRC].cdx =-3 ;
  135.      icd[iWRF].mn  = "wrf" ;  icd[iWRF].cdx =-4 ;
  136.      icd[iWRI].mn  = "wri" ;  icd[iWRI].cdx =-3 ;
  137.      icd[iWRR].mn  = "wrr" ;  icd[iWRR].cdx =-3 ;
  138.      icd[iWRS].mn  = "wrs" ;  icd[iWRS].cdx =-3 ;
  139.      icd[iXJP].mn  = "xjp" ;  icd[iXJP].cdx =-1 ;
  140. }
  141.  
  142. /****************************************/
  143. /* errchk() : P-codeソースファイルへの  */
  144. /*            出力でエラーがあったか    */
  145. /*            調べる                    */
  146. /****************************************/
  147. static void errchk(int returnfprintf)
  148. {
  149.      if(returnfprintf == EOF) {
  150.        pcerr(701,"") ;
  151.        term()        ;                  /* 終了処理                   */
  152.      }
  153. }
  154.  
  155. /**********************************/
  156. /* mes(): スタックの必要量を調べる*/
  157. /*          --> topmax            */
  158. /**********************************/
  159. static void mes(int i)
  160. {
  161.      topnew += icd[i].cdx*maxstack ;
  162.      if(topnew > topmax) topmax = topnew ;
  163.      ic++ ;                             /* Instruction Counter 更新   */
  164. }
  165.  
  166. /***************************************/
  167. /*   putic() : P-CODE付加情報出力      */
  168. /*    ソースの行番号を出力する         */
  169. /***************************************/
  170. static void putic(void)
  171. {
  172.   static oldlineno = 0;
  173.  
  174.      if(! pcdinf) return ;              /* P-code information off の時*/
  175.  
  176.      if(oldlineno != lineno) {
  177.       oldlineno = lineno ;
  178.       errchk(fprintf(pcdfile,"; %s(%d)\n",passname,lineno)) ;
  179.                                         /* ソースファイル名､行番号出力*/
  180.      }
  181. }
  182.  
  183. /************************************************/
  184. /*     gentypindicator(): 型名の出力            */
  185. /*         i : integer & 列挙型                 */
  186. /*         b : boolean                          */
  187. /*         c : char       r : real              */
  188. /*         a : pointer    s : set               */
  189. /*         m : records & arrays                 */
  190. /************************************************/
  191. static void gentypindicator(stp *fsp)
  192. {
  193.   char *type ;
  194.  
  195.      if(fsp)
  196.       switch(fsp->form) {
  197.        case subrange :                  /* 範囲型                     */
  198.          gentypindicator(fsp->sf.su.rangetype);/* 基の型について調べる*/
  199.          return ;                              /* 戻る                */
  200.  
  201.        case scalar :                    /* スカラー型                 */
  202.          if(fsp == intptr)        type = "i" ;
  203.          else if (fsp == boolptr) type = "b" ;
  204.          else if (fsp == charptr) type = "c" ;
  205.          else if (fsp->sf.sc.scalkind == declared) type = "i" ;
  206.          else                     type = "r" ;
  207.          break ;
  208.  
  209.        case pointer :                   /* ポインタ型                 */
  210.          type = "a" ;
  211.          break      ;
  212.  
  213.        case power   :                   /* 集合型                     */
  214.          type = "s" ;
  215.          break      ;
  216.  
  217.        case records :                   /* レコード                   */
  218.        case arrays  :                   /* 配列                       */
  219.          type = "m" ;
  220.          break      ;
  221.  
  222.     /* case files   : */
  223.     /* case tagfld  : */
  224.     /* case variant : */
  225.                                         /* このルートへ来てはいけない */
  226.       }
  227.      else type = " " ;                  /* 型がない時 空白を出力      */
  228.  
  229.      errchk(fprintf(pcdfile,type)) ;
  230. }
  231.  
  232. /***************************************/
  233. /*  crelabel() :ラベル値の生成         */
  234. /***************************************/
  235. int crelabel(void)
  236. {
  237.   static int labelvalue = 0 ;
  238.  
  239.      return(++labelvalue) ;
  240. }
  241.  
  242. /**************************************/
  243. /* putlabel(): ラベルの出力           */
  244. /**************************************/
  245. void putlabel(int labname)
  246. {
  247.      if(!pcode) return ;                /* 出力不要ならリターン */
  248.      errchk(fprintf(pcdfile,"L%d\n",labname)) ;
  249. }
  250.  
  251. /****************************************/
  252. /* putentv(): ent命令のオペランド値出力 */
  253. /****************************************/
  254. void putentv(int p, int q)
  255. {
  256.      if(!pcode) return ;                /* 出力不要ならリターン */
  257.      errchk(fprintf(pcdfile,"V %4d %4d\n", p, q)) ;
  258. }
  259.  
  260. /**************************************/
  261. /* putprogname(): プログラム名の出力  */
  262. /**************************************/
  263. void putprogname(char *progname)
  264. {
  265.      if(!pcode) return ;                /* 出力不要ならリターン */
  266.      errchk(fprintf(pcdfile,
  267.   "; Writen by HAPPy Pascal Compiler Version %s\n; source file=%s\nN %s\n",
  268.        version,passname,progname));
  269. }
  270.  
  271. /**************************************/
  272. /* putfilename(): ファイル名の出力    */
  273. /*         F ﾌｧｲﾙ名 ｱﾄﾞﾚｽ ｻｲｽﾞ        */
  274. /**************************************/
  275. void putfilename(char *name, int adr,int size)
  276. {
  277.      if(!pcode) return ;                /* 出力不要ならリターン */
  278.      putic()           ;
  279.      errchk(fprintf(pcdfile,"F %s %5d %5d\n", name,adr,size));
  280. }
  281.  
  282. /**************************************/
  283. /* putq(): quit指示の出力             */
  284. /**************************************/
  285. void putq(void)
  286. {
  287.      if(!pcode) return ;                /* 出力不要ならリターン       */
  288.      errchk(fprintf(pcdfile,"Q\n"));
  289. }
  290.  
  291. /***************************************/
  292. /*   putmnc() : ニーモニック出力処理   */
  293. /***************************************/
  294. static void putmnc(enum pcdmnc fop)
  295. {
  296.      putic()                                    ; /* 行番号出力       */
  297.      errchk(fprintf(pcdfile," %s",icd[fop].mn)) ; /* ニーモック出力   */
  298.      mes(fop)                                   ; /* sp増減値更新     */
  299. }
  300.  
  301. /**************************************/
  302. /* gen0(): オペランドのないP-code出力 */
  303. /**************************************/
  304. void gen0(enum pcdmnc fop)
  305. {
  306.      if(!pcode) return ;                /* 出力不要ならリターン       */
  307.      putmnc(fop)       ;
  308.      errchk(fprintf(pcdfile,"\n")) ;
  309. }
  310.  
  311. /************************************************/
  312. /* genp(): パラメータがpで､ 型のないP-code出力  */
  313. /************************************************/
  314. void genp(enum pcdmnc fop, int fp)
  315. {
  316.      if(!pcode) return ;                /* 出力不要ならリターン       */
  317.      putmnc(fop)       ;
  318.      errchk(fprintf(pcdfile,"%4d\n",fp)) ;
  319. }
  320.  
  321. /************************************************/
  322. /* genq(): パラメータがqで､ 型のないP-code出力  */
  323. /************************************************/
  324. void genq(enum pcdmnc fop, int fq)
  325. {
  326.      if(!pcode) return ;                /* 出力不要ならリターン       */
  327.      putmnc(fop)       ;
  328.      errchk(fprintf(pcdfile,"%12d\n",fq)) ;
  329. }
  330.  
  331. /*************************************************/
  332. /*    gen0t() : パラメータがなくて型名のある命令 */
  333. /*                 の出力                        */
  334. /*************************************************/
  335. void gen0t(enum pcdmnc fop,stp *fsp)
  336. {
  337.      if(!pcode) return ;                /* 出力不要ならリターン       */
  338.      putmnc(fop)       ;
  339.      gentypindicator(fsp)  ;            /* 型の出力                   */
  340.      errchk(fprintf(pcdfile,"\n")) ;
  341. }
  342.  
  343. /************************************************/
  344. /*    gen1t() : パラメータ1つで型名のある命令   */
  345. /*                 の出力                       */
  346. /************************************************/
  347. void gen1t(enum pcdmnc fop,stp *fsp, int fq)
  348. {
  349.      if(!pcode) return ;                /* 出力不要ならリターン       */
  350.      putmnc(fop)       ;
  351.      gentypindicator(fsp) ;             /* 型の出力                   */
  352.      errchk(fprintf(pcdfile,"%11d\n",fq)) ;
  353. }
  354.  
  355. /************************************************/
  356. /*    gen2t() : パラメータが2つで型名のある命令 */
  357. /*                 の出力                       */
  358. /************************************************/
  359. void gen2t(enum pcdmnc fop, stp *fsp, int fp,int fq)
  360. {
  361.      if(!pcode) return ;                /* 出力不要ならリターン       */
  362.      putmnc(fop)       ;
  363.      gentypindicator(fsp) ;             /* 型の出力                   */
  364.      errchk(fprintf(pcdfile," %2d %7d\n",fp,fq)); /* p と q の出力    */
  365. }
  366.  
  367. /************************************************/
  368. /*    genent(): ent命令の出力                   */
  369. /************************************************/
  370. void genent(void)
  371. {
  372.      if(!pcode) return ;                /* 出力不要ならリターン       */
  373.      putmnc(iENT)      ;
  374.      errchk(fprintf(pcdfile,"   V\n")) ;
  375. }
  376.  
  377. /************************************************/
  378. /*    genret(): ret命令の出力                   */
  379. /************************************************/
  380. void genret(stp *fsp)
  381. {
  382.      if(!pcode) return ;                /* 出力不要ならリターン       */
  383.      if(fsp) gen0t(iRET,fsp) ;          /* 型に応じたret命令          */
  384.      else {                             /* 型がない時                 */
  385.       putmnc(iRET) ;
  386.       errchk(fprintf(pcdfile, "p\n")) ; /* retp命令                   */
  387.      }
  388. }
  389.  
  390. /************************************************/
  391. /*    genlca(): lca命令の出力                   */
  392. /*                 lca '文字列'\n               */
  393. /************************************************/
  394. static void genlca(void)
  395. {
  396.      if(!pcode) return ;                /* 出力不要ならリターン       */
  397.      putmnc(iLCA)      ;
  398.      errchk(fprintf(pcdfile, " '%s'\n",gattr.cval.valp->c.sval)) ;
  399. }
  400.  
  401. /************************************************/
  402. /*    genlda(): lda命令の出力                   */
  403. /*                 lda  p  q                    */
  404. /************************************************/
  405. void genlda(int fp,int fq)
  406. {
  407.      if(!pcode) return ;                /* 出力不要ならリターン       */
  408.      putmnc(iLDA)      ;
  409.      errchk(fprintf(pcdfile, " %3d %7d\n", fp, fq));
  410. }
  411.  
  412. /************************************************/
  413. /*    genixa(): ixa命令の出力                   */
  414. /*                 ixa  p  q                    */
  415. /************************************************/
  416. void genixa(long fp,int fq)
  417. {
  418.      if(!pcode) return ;                /* 出力不要ならリターン       */
  419.      putmnc(iIXA)      ;
  420.      errchk(fprintf(pcdfile, " %3ld %7d\n",  fp, fq));
  421. }
  422.  
  423. /***************************************************/
  424. /*    genldc(): ldc命令の出力                      */
  425. /*       ldci q        整数値をスタックにのせる    */
  426. /*       ldcr ･･･.･･･  実数値をスタックにのせる    */
  427. /*       ldcb q        boolean値をスタックのせる   */
  428. /*       ldcn          nilをスタックにのせる       */
  429. /*       ldcc 'q'      文字をスタックにのせる      */
  430. /*       ldcs (･ ･ ･)  集合の要素をスタックにのせる*/
  431. /***************************************************/
  432. void genldc(char ftype,long fq)
  433. {
  434.   int i ;
  435.  
  436.      if(!pcode) return ;                /* 出力不要ならリターン       */
  437.      putmnc(iLDC)      ;
  438.      switch(ftype) {
  439.       case 'i' :
  440.       case 'b' : errchk(fprintf(pcdfile,"%c %10ld\n",ftype,fq)) ;
  441.                  break ;
  442.       case 'r' : errchk(fprintf(pcdfile,"r %s\n",gattr.cval.valp->c.rval)) ;
  443.                  break ;
  444.       case 'n' : errchk(fprintf(pcdfile,"n\n")) ;   /* fqはない */
  445.                  break ;
  446.       case 'c' : errchk(fprintf(pcdfile,"c '%c'\n",(char)fq)) ;
  447.                  break ;
  448.       case 's' : errchk(fprintf(pcdfile,"s (")) ;
  449.                  for(i=0; i<=sethigh; i++)
  450.                   if((gattr.cval.valp->c.pval >> i) & 0x1) /* 要素あり*/
  451.                    errchk(fprintf(pcdfile,"%3d",i)) ;
  452.                  errchk(fprintf(pcdfile,")\n")) ;
  453.      }
  454. }
  455.  
  456. /************************************************/
  457. /*    gencupejp(): cup, ejp命令の出力           */
  458. /*       cup  引数の数  手続きのラベル          */
  459. /*       ejp  水準差    ラベル                  */
  460. /************************************************/
  461. void gencupejp(enum pcdmnc fop, int fp1, int fp2)
  462. {
  463.      if(!pcode) return ;                /* 出力不要ならリターン       */
  464.      putmnc(fop)       ;
  465.      errchk(fprintf(pcdfile," %3d   L%4d\n", fp1, fp2 )) ;
  466. }
  467.  
  468. /************************************************/
  469. /*    genjump(): jump関係の命令出力             */
  470. /*                ujp / fjp                     */
  471. /************************************************/
  472. void genjump(enum pcdmnc fop, int fq)
  473. {
  474.      if(!pcode) return ;                /* 出力不要ならリターン       */
  475.      putmnc(fop)       ;
  476.      errchk(fprintf(pcdfile,"       L%4d\n", fq)) ;
  477. }
  478.  
  479. /************************************************/
  480. /*    gencompare(): 比較関係の命令出力          */
  481. /*                   les/leq/grt/geq/neq/equ    */
  482. /************************************************/
  483. void gencompare(enum pcdmnc fop, char ftypind,int fq)
  484. {
  485.      if(!pcode) return ;                /* 出力不要ならリターン       */
  486.      putmnc(fop)       ;
  487.      if(ftypind == 'm')                 /* 文字列比較                 */
  488.       errchk(fprintf(pcdfile,"m%11d\n",fq))   ;      /* 比較長を出力  */
  489.      else
  490.       errchk(fprintf(pcdfile,"%c\n",ftypind)) ;
  491. }
  492.  
  493. /************************************************/
  494. /*    convertint() : 必要ならばord命令を生成    */
  495. /*      boolean型か､列挙型でなく                */
  496. /*      integer型に適合しなければ ord命令を生成 */
  497. /************************************************/
  498. void convertint(stp *fsp)
  499. {
  500.      if(fsp == intptr) return ;
  501.      if((fsp->form == scalar) && (fsp->sf.sc.scalkind == declared)
  502.         && (fsp != boolptr)) return ;
  503.      if(fsp->form   == subrange) {
  504.       if(fsp->sf.su.rangetype == intptr) return ;
  505.       if((fsp->sf.su.rangetype->form == scalar) &&
  506.           (fsp->sf.su.rangetype->sf.sc.scalkind == declared)
  507.         && (fsp->sf.su.rangetype != boolptr)) return ;
  508.      }
  509.      gen0t(iORD,fsp) ;
  510. }
  511.  
  512. /************************************************/
  513. /*    load() : ロード関係の命令の出力           */
  514. /************************************************/
  515. void load(void)
  516. {
  517.   char kind ;
  518.  
  519.      if(!gattr.typtr) return ;          /* 型がなければ何もしない     */
  520.  
  521.      switch(gattr.kind) {               /* 種類で振り分ける           */
  522.       case cst :                        /* 定数                       */
  523.        if(gattr.typtr->form == scalar) {/* スカラー                   */
  524.         if(gattr.typtr == intptr)       kind = 'i' ;  /*   整数       */
  525.         else if(gattr.typtr == charptr) kind = 'c' ;  /*   文字       */
  526.         else if(gattr.typtr == boolptr) kind = 'b' ;  /*   boolean    */
  527.         else if(gattr.typtr == realptr) kind = 'r' ;  /*   実数       */
  528.         else                            kind = 'i' ;  /*   列挙型     */
  529.        }
  530.        else if(gattr.typtr == nilptr)   kind = 'n' ;  /*  nil の時    */
  531.        else                             kind = 's' ;  /*  集合型      */
  532.        genldc(kind,gattr.cval.ival) ;   /* 'r','n','s' の時はival無効 */
  533.        break ;
  534.  
  535.       case varbl :                      /* 変数                       */
  536.        if(gattr.access == drct)         /*  直接参照                  */
  537.         if(gattr.vlevel <= 1)           /*  大域変数(1),標準変数(0)   */
  538.          gen1t(iLDO,gattr.typtr,gattr.dplmt) ;
  539.         else                            /*  局所変数                  */
  540.          gen2t(iLOD,gattr.typtr,level-gattr.vlevel,gattr.dplmt) ;
  541.        else                             /*  間接参照                  */
  542.         gen1t(iIND,gattr.typtr,gattr.idplmt) ;
  543.        break ;
  544.  
  545. /*    case expr : */                    /* 式の場合はすでに値がstackに*/
  546. /*     break ;    */                    /* 載っているので何もしない   */
  547.      }
  548.  
  549.      gattr.kind = expr ;                /* これ以降は式の扱いのため
  550.                                           次回はloadが生成されない    */
  551. }
  552.  
  553. /****************************************************/
  554. /*    loadaddress() : アドレスロード関係命令の出力  */
  555. /****************************************************/
  556. void loadaddress(void)
  557. {
  558.      if(!gattr.typtr) return ;          /* 型がなければ何もしない     */
  559.  
  560.      switch(gattr.kind) {               /* 種類で振り分ける           */
  561.       case cst :                        /* 定数                       */
  562.         if(string(gattr.typtr))         /*  文字列ならば              */
  563.          genlca() ;                     /*  lca命令出力               */
  564.         break ;
  565.  
  566.       case varbl :                      /* 変数                       */
  567.        if(gattr.access == drct)         /*  直接参照                  */
  568.         if(gattr.vlevel <= 1)
  569.          genq(iLAO,gattr.dplmt) ;       /*  lao命令の出力             */
  570.         else
  571.          genlda(level-gattr.vlevel,gattr.dplmt) ; /* lda命令の出力    */
  572.        else                             /*  間接参照(indrct)          */
  573.         if(gattr.idplmt != 0)
  574.          gen1t(iINC,nilptr,gattr.idplmt) ; /* inc命令の出力           */
  575.        break ;
  576.  
  577.    /* case expr :*/                     /* 式                         */
  578.                                         /* 本来はこのルートはない     */
  579.      }
  580.  
  581.      gattr.kind   = varbl ;
  582.      gattr.access = indrct ;
  583.      gattr.idplmt = 0 ;
  584. }
  585.  
  586. /******************************************/
  587. /*     store() : ストア関係命令の出力     */
  588. /******************************************/
  589. void store(attr fattr)
  590. {
  591.  
  592.      if(!gattr.typtr) return ;          /* 型がなければ何もしない     */
  593.  
  594.      if(fattr.access == drct)           /* 直接参照                   */
  595.       if(fattr.vlevel <= 1)             /* 大域変数(1) 標準変数(0)    */
  596.        gen1t(iSRO,fattr.typtr,fattr.dplmt) ;       /* sro命令         */
  597.       else                              /* 局所変数                   */
  598.        gen2t(iSTR,fattr.typtr,level-fattr.vlevel,fattr.dplmt);/*str命令*/
  599.      else                               /* 間接参照                   */
  600.       gen0t(iSTO,fattr.typtr) ;         /*  sto命令                   */
  601.                                         /* fattr.idplmt != 0 のこと   */
  602. }
  603.  
  604. /****************************************/
  605. /*    genchk()  : chk命令の出力         */
  606. /*                 chk型 種別 下限 上限 */
  607. /****************************************/
  608. void genchk(stp *fsp, int kind, long min, long max)
  609. {
  610.      if(!pcode) return ;                /* 出力不要ならリターン       */
  611.      putmnc(iCHK)      ;
  612.      gentypindicator(fsp) ;             /* 型の出力                   */
  613.      errchk(fprintf(pcdfile," %2d %ld %ld\n", kind,min, max)) ;
  614. }
  615.  
  616. /*************************************************/
  617. /*  checkbounds() : 上･下限のチェック命令の出力  */
  618. /*************************************************/
  619. void checkbounds(stp *fsp,int kind)
  620. {
  621.   long lmin,lmax ;
  622.  
  623.      if((!debug)         ||             /* debugでない                */
  624.         (!fsp)           ||             /* 型がない                   */
  625.         (fsp == intptr)  ||             /* 整数型                     */
  626.         (fsp == charptr) ||             /* 文字型                     */
  627.         (fsp == realptr) ||             /* 実数型                     */
  628.         (fsp == boolptr)) return ;      /* booleanならばチェック不要  */
  629.                                         /* スカラー,範囲型,集合型の時
  630.                                            しか、この処理は呼ばれない */
  631.      getbounds(fsp,&lmin,&lmax) ;       /* その型の上限､下限を求める  */
  632.      genchk(fsp,kind,lmin,lmax) ;       /* chk命令生成                */
  633. }
  634.